home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HAM Radio 1997
/
HAM Radio 1997.iso
/
vcls
/
tpxtable
/
pxtable.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-04-08
|
9KB
|
204 lines
unit Pxtable;
interface
Uses
DB, DBTables, SysUtils, Classes, DBIProcs, DBITypes, DBIErrs,
Dialogs, Forms, Controls;
Type
{ Table type for cascaded master-detail
delete sequence for Paradox tables }
TPXTable = Class(TTable)
Private
FCheckDelOp : Boolean;
Public
Procedure DoBeforeDelete; Override;
Published
{ False = don't check the table's cascaded delete property:
always delete detail records
True = delete detail records if the table's cascaded
delete property is RintCascade
Don't set this property to True - I don't know why,
but the cascaded delete property of the master tables is
never RintCascade... }
Property CheckDelOp : Boolean Read FCheckDelOp Write FCheckDelOp Default False;
End;
{ Registration procedure }
Procedure Register;
implementation
{ New DoBeforeDelete method }
Procedure TPXTable.DoBeforeDelete;
{ Recursively deletes cascaded records in related tables }
Procedure DeleteDetailRecords(DataBaseHandle : hDBIDb; { Database cursor }
MasterHandle : hDBICur; { Master table cursor }
MasterTableName : TFileName); { Master table name }
{ Some variables are unnecessary, but the code is readable... }
Var
{ RintXXX - referential integrity variables }
RintCur : HDBICur; { Rint table cursor handle }
RintProps : CurProps; { Rint table properties }
RintRec : PRintDesc; { Rint record buffer }
RintEof : Boolean; { True = end of Rint table }
{ MstXXX - master table variables }
MstCur : HDBICur; { Cloned master table cursor handle }
MstName : DBIPath; { Null terminated name of the master table }
MstFields : DBIKey; { Rint fields in master table }
{ DetXXX - detail table variables }
DetCur : HDBICur; { Detail table cursor handle }
DetName : DBIPath; { Null terminated name of the detail table }
DetFields : DBIKey; { Rint fields in detail table }
DetRecCount : LongInt; { Number of detail records }
DetIdxCount : Word; { Number of detail indexes }
DetIdx : Word; { Detail table index number for DBIOpenTable }
DetIdxDesc : IdxDesc; { Detail table index descriptor }
DetFieldCount : Word; { Counts detail table fields to find the detail index }
DetProps : CurProps; { Detail table properties }
DetIdxFound : Boolean; { True = detail index found }
LinkFields : Word; { Number of linked fields }
{ Other variables }
Rslt : DBIResult; { DBI result }
I,J : Integer; { For searching the detail index }
Begin
{ Store master table name in null terminated format }
StrPCopy(MstName,MasterTableName);
{ Open Rint table }
Check(DBIOpenRintList(DataBaseHandle,MstName,szPARADOX,RintCur));
{ Get Rint table properties to get the Rint record size }
DBIGetCursorProps(RintCur,RintProps);
Try
{ Allocate Rint record buffer }
GetMem(RintRec,RintProps.iRecBufSize);
{ Get the next Rint record }
While DBIGetNextRecord(RintCur,dbiNoLock,RintRec,Nil) = 0 Do
{ If this table is master and cascaded delete enabled then continue }
If (RintRec^.eType = RintMaster) And ((RintRec^.eDelOp = RintCascade) Or Not FCheckDelOp) Then
Begin
{ Save Rint record fields }
StrCopy(DetName,RintRec^.szTblName);
MstFields := RintRec^.aiThisTabFld;
DetFields := RintRec^.aiOthTabFld;
LinkFields := RintRec^.iFldCount;
{------------------------------------------------------------}
{ Determining detail index for DBILinkDetail }
Check(DBIOpenTable(DataBaseHandle,DetName,szPARADOX,
Nil,Nil,0,DBIReadWrite,DBIOpenShared,xltNone,
False,Nil,DetCur));
Try
{ Get detail table properties }
Check(DBIGetCursorProps(DetCur,DetProps));
DetIdxCount := DetProps.iIndexes;
DetIdx := 1;
DetIdxFound := False;
While (DetIdx <= DetIdxCount) And Not DetIdxFound Do
Begin
{ Get detail table index descriptor }
Check(DBIGetIndexDesc(DetCur,DetIdx,DetIdxDesc));
DetFieldCount := 0;
For I := 0 To LinkFields-1 Do
For J := 0 To LinkFields-1 Do
If DetIdxDesc.aiKeyFld[J] = DetFields[I] Then
Inc(DetFieldCount);
DetIdxFound := DetFieldCount >= LinkFields;
If DetIdxFound
Then
DetIdx := DetIdxDesc.iIndexId
Else
Inc(DetIdx);
End;
Finally
DBICloseCursor(DetCur);
End;
{------------------------------------------------------------}
{ Open detail table }
Check(DBIOpenTable(DataBaseHandle,DetName,szPARADOX,
Nil,Nil,DetIdx,DBIReadWrite,DBIOpenShared,xltNone,
False,Nil,DetCur));
Try
{ Open secondary master table }
Check(DBIOpenTable(DataBaseHandle,MstName,szPARADOX,
Nil,Nil,0,DBIReadOnly,DBIOpenShared,xltNone,
False,Nil,MstCur));
{ Setup cursors for link link mode and establish link }
Check(DBIBeginLinkMode(DetCur));
Check(DBIBeginLinkMode(MstCur));
Check(DBILinkDetail(MstCur,DetCur,LinkFields,@MstFields,@DetFields));
Try
{ Update secondary master cursor }
Check(DBISetToCursor(MstCur,MasterHandle));
Check(DBIGetRecord(MstCur,DBINoLock,Nil,Nil));
Check(DBISetToBegin(DetCur));
Check(DBIGetRecordCount(DetCur,DetRecCount));
{ Delete related records if they exists }
If DetRecCount > 0 Then
While DBIGetNextRecord(DetCur,dbiNoLock,Nil,Nil) = 0 Do
Begin
{ Delete subsequent detail records }
DeleteDetailRecords(DataBaseHandle,DetCur,StrPas(DetName));
{ Delete detail record }
Check(DBIDeleteRecord(DetCur,Nil));
End;
Finally
{ Unlink tables and restore cursors to normal mode }
DBIUnlinkDetail(DetCur);
DBIEndLinkMode(DetCur);
DBIEndLinkMode(MstCur);
End;
Finally
{ Close table cursors }
DBICloseCursor(MstCur);
DBICloseCursor(DetCur);
End;
End;
Finally
{ Release Rint record buffer and close Rint cursor }
FreeMem(RintRec,RintProps.iRecBufSize);
DBICloseCursor(RintCur);
End;
End;
{ DoBeforeDelete statement block }
Begin
{ Execute inherited DoBeforeDelete }
Inherited DoBeforeDelete;
{ Cascaded delete occurs if the type of the table is Paradox.
The type of the table is Paradox, if the TableType property is
ttParadox or ttDefault and the file extension is '.DB' or empty }
If (TableType = ttParadox) Or
(TableType = ttDefault) And ((ExtractFileExt(TableName) = '.DB') Or (ExtractFileExt(TableName) = '')) Then
Begin
{ Update table cursor }
UpdateCursorPos;
Try
Try
{ Set screen cursor to hourglass }
Screen.Cursor := crHourGlass;
{ Delete cascaded records }
DeleteDetailRecords(DataBase.Handle,Handle,TableName);
Finally
{ Restore screen cursor to default }
Screen.Cursor := crDefault;
End;
Except
Raise;
End;
End;
End;
{ Registration procedure }
Procedure Register;
Begin
RegisterComponents('Data Access',[TPXTable]);
End;
end.